<!DOCTYPE stack PUBLIC "-//Apple, Inc.//DTD stack V 2.0//EN" "" >
<stack>
<name>in.401</name>
<id>-1</id>
<cardCount>19</cardCount>
<cardID>11076</cardID>
<listID>12130</listID>
<cantModify><false /></cantModify>
<cantDelete><true /></cantDelete>
<cantAbort><false /></cantAbort>
<cardSize>
<width>512</width>
<height>342</height>
</cardSize>
<script>-- BSA Troop Tracker© is a product of HyperMac Software and Keith D. Kaiser, 4904 NW 67th Terrace-- Kansas City, MO 64151. If you include this stack on a CD-ROM it would be nice of you to send-- me a complementary copy. This stack is patch ware, send me a council strip or $30.00 which ever-- is easiest. Send enhancement ideas to: Internet -- USVV7J8N@IBMMAIL.COM or AOL -- KKAISERon openStackglobal MarkedList,transferOut,priorLevel,theList,theCurs,bgList,TroopNamego cd "Members" of bg membersplay twinkleput cd fld "Troop Number" into TroopNameput "S,TF,SC,FC,ST,REPORTS,L,MAP,E,CALENDAR,HELP,MEMBERS,LEADERS" ¬into theListput "16106,16106,461,20705,1744,11592,14324,1007,6883,21789," & ¬"15998,256" into theCursput "Scouts,Leaders,Members,Requirements,Maps,Scout,Tenderfoot," & ¬"Second Class, First Class, Star, Life, Eagle, Skill Awards," & ¬"Palms, Merit Badges, Misc Awards & Training" into bgListlock screenmarkCds -- mark all active Scouts & Scouters--hide the menu bar only on small screensput item 2 of screenRect into screenTopif top of card window < screenTop + 20 then hide menuBarput the userLevel into priorLevelset the userLevel to 5end openStackfunction Locate string,containerrepeat with i = 1 to number of lines in containerif line i of container contains string thenput i & "," after lineListend ifnext repeatend repeatdelete last char of lineListreturn lineListend Locate---------------------------------------------------------function mbListsend mouseUp to bg btn "MB"put 1 into mbListCountif fld MBcount is empty or word 1 of fld MBcount is 0 thenreturn "No Merit Badges earned."elserepeat with i = 1 to number of lines in fld meritBadgesset cursor to busyget line i of fld meritBadgesif char 5 of it is not " " thendelete word 1 of itif mbListCount < 2 thenput it & "," after mbListelseput it & "," & return after mbListput 0 into mbListCountend ifadd 1 to mbListCountend ifend repeatsend mouseUp to bg btn "about"return align(mbList,"38,L","35,L")end ifend mbList---------------------------------------------------------function EagleListreturn "First Aid,Citz. in Community,Citz. in Nation,Citz. in World," & ¬"Communications,Environmental Science,Family Life (9/1/94),Personal Management," & ¬"Safety,Emergency Prep.,Lifesaving,Personal Fitness,Swimming," & ¬"Sports,Camping"end EagleList---------------------------------------------------------function SkillAwardsreturn "Camping,Citizenship,Communications,Community,conservation," & ¬"Cooking,Environment,Family,First Aid,Hiking,Physical Fitness," & ¬"Swimming"end SkillAwards---------------------------------------------------------function RankListreturn "Scout,Tenderfoot,Second Class,First Class,Star,Life,Eagle"end RankList---------------------------------------------------------function listingreturn ¬"EagleList,RankList,MoS,OOTA,Leadership,Special,Meritbadgelist"end listing---------------------------------------------------------function MoSreturn ¬"Mic-O-Say,Foxman,Brave,Warrior,Firebuilder," & ¬"Tomtom Beater,Runner,K.S.B.,Shaman," & ¬"Sachem,K.W.,Sagamore,Medicine Man"end Mos---------------------------------------------------------function OOTAreturn ¬"Order of The Arrow,Ordeal,Brotherhood,Vigil"end OOTA---------------------------------------------------------function Leadershipreturn "Chaplain aide,J.A.S.M.,S.P.L.,A.S.P.L.,Instructor,Scribe," & ¬"Patrol Leader,Asst. Patrol Leader,Quartermaster,Librarian," & ¬"Den chief,Bugler,Historian,Musician,Troop guide,Scoutmaster," & ¬"Asst. Scoutmaster,Comm. Chairman,Committee,Chaplain"end Leadership---------------------------------------------------------function Specialreturn ¬"Religious Emblem," & ¬"Totin Chip," & ¬"World Conservation," & ¬"Snorkeling," & ¬"Mile Swim," & ¬"Paul Bunyan Woodman," & ¬"50 Miler Award," & ¬"Patrol Leader Training," & ¬"Firm'n Chit," & ¬"Brown Sea Double Two," & ¬"Historic Trails Award," & ¬"Camp Staff," & ¬"High Adventure Base," & ¬"National Jamboree," & ¬"World Jamboree"end Special---------------------------------------------------------function AllBgsreturn ¬"Scout,Tenderfoot,Second Class,First Class," & ¬"Star,Life,Eagle,Skill Awards,Palms,Merit Badges," & ¬"Misc Awards & Training," & ¬"NScout,NTenderfoot,NSecondClass,NFirstClass,Advancement"end AllBgs---------------------------------------------------------function howLong infieldput the short date into SecondDateput infield into FirstDateconvert FirstDate to secondsconvert SecondDate to secondsput (SecondDate - FirstDate)/(365.25*24*60*60) into Yrsput trunc (yrs) into IntYearsput (yrs-intYears)*12 into mnthsput trunc (mnths) into IntMonthsput (mnths-IntMonths)*4.333333 into wksput trunc (wks) into Intweeksput trunc ((wks-IntWeeks)*7) into Intdaysif intYears = 0 thenput IntMonths & "m" && IntWeeks & "w" into howLongelseput IntYears & "y" && IntMonths & "m" into howLongend ifreturn howLongend howLong---------------------------------------------------------function AoLif the hilite of bg btn "Arrow of Light?" is truethen return "Yes"else return "No"end AoL---------------------------------------------------------function saListsend mouseUp to bg btn "SA"put line 1 of fld "Skill Awards" & "," & line 7 of fld "Skill Awards" & return & ¬line 2 of fld "Skill Awards" & "," & line 8 of fld "Skill Awards" & return & ¬line 3 of fld "Skill Awards" & "," & line 9 of fld "Skill Awards" & return & ¬line 4 of fld "Skill Awards" & "," & line 10 of fld "Skill Awards" & return & ¬line 5 of fld "Skill Awards" & "," & line 11 of fld "Skill Awards" & return & ¬line 6 of fld "Skill Awards" & "," & line 12 of fld "Skill Awards" ¬into saListsend mouseUp to bg btn "About"return align(saList,"30,L","30,L")end saList---------------------------------------------------------function leaderPosput 1 into counterif strCount("•",fld Leadership) = 0 thenreturn "No leadership positions have been held yet."elserepeat with i = 1 to the number of lines in fld Leadershipset cursor to busyget line i of fld Leadershipif char 1 of it is "•" thendelete word 1 of itif counter < 2 thenput it & "$" after leaderPoselseput it & "$" & return after leaderPosput 0 into counterend ifadd 1 to counterend ifend repeatreturn align(leaderPos,"$","40,L","40,L")end ifend leaderPos---------------------------------------------------------function specialRecput 1 into counterif strCount("•",fld "Special Recognition") = 0 thenreturn "No items yet."elserepeat with i = 1 to the number of lines in fld "Special Recognition"set cursor to busyget line i of fld "Special Recognition"if char 1 of it is "•" thendelete word 1 of itif counter < 2 thenput it & "$" after specialRecelseput it & "$" & return after specialRecput 0 into counterend ifadd 1 to counterend ifend repeatreturn align(specialRec,"$","40,L","40,L")end ifend specialRec---------------------------------------------------------function summerCampput 1 into counterif strCount("•",fld "Summer Camp") = 0 thenreturn "Has not attended summer camp yet."elserepeat with i = 1 to the number of lines in fld "Summer Camp"set cursor to busyget line i of fld "Summer Camp"if char 1 of it is "•" thendelete word 1 of itif counter < 3 thenput it & "$" after summerCampelseput it & "$" & return after summerCampput 0 into counterend ifadd 1 to counterend ifend repeatreturn align(summerCamp,"$","20,L","20,L","20,L")end ifend summerCamp---------------------------------------------------------function miscsend mouseUp to bg btn "Misc"put "Mic-O-Say --" & return & ¬fld "Comments" & return after Miscrepeat with i = 1 to the number of lines in fld "Mic-O-Say"set cursor to busyget line i of fld "Mic-O-Say"if char 1 of it is "•" thenput it & ", " after Miscend ifend repeatput return & return & "Order of The Arrow --" & return after Miscrepeat with i = 1 to the number of lines in fld "Order of The Arrow"set cursor to busyget line i of fld "Order of The Arrow"if char 1 of it is "•" thenput it & ", " after Miscend ifend repeatput return & return & "Leadership Positions --" & return & ¬leaderPos() after Miscput return & return & "Special Recognition --" & return & ¬specialRec() after Miscput return & return & "Summer Camp History --" & return & ¬summerCamp() after Miscsend mouseUp to bg btn "about"return miscend misc---------------------------------------------------------function rankDatessend mouseUp to bg btn "S"put "Scout Awarded:" && bg fld "Awarded" & "," into sAwardsend mouseUp to bg btn "ST"put "Star Awarded:" && bg fld "Awarded" & return after sAwardsend mouseUp to bg btn "TF"put "Tenderfoot Awarded:" && bg fld "Awarded" & "," after sAwardsend mouseUp to bg btn "L"put "Life Awarded:" && bg fld "Awarded" & return after sAwardsend mouseUp to bg btn "SC"put "Second Class Awarded:" && bg fld "Awarded" & "," after sAwardsend mouseUp to bg btn "E"put "Eagle Awarded:" && bg fld "Awarded" & return after sAwardsend mouseUp to bg btn "FC"put "First Class Awarded:" && bg fld "Awarded" after sAwardsend mouseUp to bg btn "about"return align(sAward,"35,L","30,L")end rankDates---------------------------------------------------------function palmStuffif fld palmCount = 0 or fld palmCount is empty thenput "Total Palms Earned ==> 0" into palmStuffend ifput fld palmCount into palmCountsend mouseUp to bg btn "P"if fld bronze_1_awarded is not empty thenput "Total Palms Earned ==>" && PalmCount & return & ¬"First Cluster, Bronze -" && fld bronze_1_awarded && ¬"Gold -" && fld gold_1_awarded && "Silver -" && fld silver_1_awarded & ¬return after palmStuffif fld bronze_2_awarded is not empty thenput "Second Cluster, Bronze -" && fld bronze_2_awarded && ¬"Gold -" && fld gold_2_awarded && "Silver -" && fld silver_2_awarded & ¬return after palmStuffif fld bronze_3_awarded is not empty thenput "Third Cluster, Bronze -" && fld bronze_3_awarded && ¬"Gold -" && fld gold_3_awarded && "Silver -" && fld silver_3_awarded & ¬return after palmStuffend ifend ifend ifsend mouseUp to bg btn "about"return palmStuffend palmStuff---------------------------------------------------------function TroopNumreturn cd fld "Troop Number" of cd Membersend TroopNum---------------------------------------------------------function buildHistoryput "*** Individual History/Transfer Report ***" && ¬TroopNum() & "--" && the short date & return & ¬"--------------------------------------------------------------------------" ¬& return & return & ¬fld "Name" & return & "DOB:" && fld "Birthdate" & tab & tab & ¬"Joined Scouts:" && fld "DateJoined" & return & ¬"Phone(s):" && fld "Phone" && " " && fld "Phone 2" & return & ¬fld "Address" & return & ¬fld "City" & "," && fld "State" & return & return & ¬first word of fld "Name" && "is on the" && fld "Plan" & return & return & ¬"Rank Awards:" & return & ¬"Earned Arrow of Light as a WEBELO? ==>" && AoL() & return & ¬rankDates() & return & ¬"Patrol ==>" && fld "Patrol" & return & ¬"Post ==>" && fld "Post" && "on" && fld "PostDateStart" & return & ¬"Attendance ==>" && "(M= " & fld "meetAttnd" & ") (A= " & ¬fld activityAttnd & ") (T= " & fld attendance & ")" & ¬return & return & ¬"Skill Awards -- " && fld "SACount" && "• earned" & return & ¬saList() & return & ¬"Merit Badge Report -- " & return & ¬" Earned (Eagle/Total):" && fld "EagleMbCount" & return & ¬palmStuff() & return & ¬" Legend: What for, date, Merit badge name" & return & ¬"F - First Class, S - Star, L - Life, E - Eagle," && ¬"B - Bronze, G - Gold, P - Silver, * - Eagle Required" && ¬"• - Not Assigned" & return & return & ¬mbList() & return & ¬"Misc. Information" & return & ¬"-----------------" & return & ¬Misc() & return & "NOTES --" & return & fld "Comments" & return ¬after transferOutgo cd stackInforeturn transferOutend buildHistory---------------------------------------------------------on markCdsglobal MarkedListput "Please stand by, initializing database..."put empty into MarkedListlock screenunmark all cdsmark cds by finding " Active" in bg fld "ActiveOrNot"unmark cds by finding "Not" in bg fld "ActiveOrNot"repeat for number of marked cdsgo next marked cdput bg fld "Name" & "," after MarkedListend repeatgo first cdhide msgend markCds---------------------------------------------------------on activeSwitchif target is empty then put "Active" into line 1 of targetif first word of target is "Active" thenput "Not Active" into line 1 of field "ActiveOrNot"else if first word of target is "Not" thenput "History" into line 1 of field "ActiveOrNot"else if first word of target is "History" thenput "Transfered" into line 1 of field "ActiveOrNot"else if first word of target is "District" thenput "Active" into line 1 of field "ActiveOrNot"else if first word of target is "Transfered" thenput "District" into line 1 of field "ActiveOrNot"end ifend activeSwitch---------------------------------------------------------on setScroll field,nset scroll of field to nend setScrollon setVis field,tfset visible of field to tfend setVis---------------------------------------------------------on deleteScoutanswer "Delete records for Leaders too?" with "No" or "Yes"if it is "Yes" thenask "Delete which Scout?"if it is not empty thenput it into nameanswer "Delete all the records for" && name & "?" ¬with "Yes" or "Cancel"if it is "Cancel" then exit deleteScoutlock screenset lockMessages to trueput empty into cd fld "Members"put "Deleting all records for" && name & ", please stand by!"go nextrepeat foreverset cursor to busyfind whole nameif the result is not emptythen exit repeatelse doMenu "Delete Card"end repeatgo cd "Members"end ifend ifend deleteScout---------------------------------------------------------on helpgo to cd helpend help---------------------------------------------------------on listMBsForHimglobal mbList, mbCnt, EmbCnt, namelock screenset lockMessages to trueput fld "Name" into namepush cdgo first cd of bg "Merit Badges"find whole Nameput fld meritBadges into tempBadgesput 0 into mbCntput 0 into EmbCntrepeat with i = 1 to the number of lines in tempBadgesset cursor to busyget line i of tempBadgesif char 5 of it is not " " thendelete word 1 of itput it & "," after mbListadd 1 to mbCntend ifif char 5 of it is not " " and ¬it contains "*" then add 1 to EmbCntend repeatpop cdput "Merit Badge list for" && Name & return & ¬mbCnt && "total," && EmbCnt && "from the Eagle list." into promptget showList(mbList,comma,prompt,true,"OK,Cancel,Help^") -- ∆if line 1 of it is "Cancel" then exit listMBsForHimif line 1 of it is "Help" thengo cd "Help"exit listMBsForHimend ifend listMBsForHim---------------------------------------------------------on updateListing op,memorled,whichListglobal memNames,x,howLong,peepCnt,markedListlock screenunmark all cdsset lockMessages to trueif op is empty thenput "Phone" into opend ifPut empty into cd fld memorledgo cd "Members"if memorled is "Members" then-- sort cds of bg "Scouts" by word 2 of fld Nameput the number of cds of bg "Scouts" into statCntelse-- sort cds of bg "Leaders" by word 2 of fld Nameput the number of cds of bg "Leaders" into statCntend ifif memorled is "Members" thengo first cd of bg "Scouts"elsego first cd of bg "Leaders"end ifput empty into memNames -- initialize the containerput 1 into x -- initialize the counterput 0 into PeepCnt -- initialize the people counterrepeat with i = 1 to statCntset cursor to busyif fld "ActiveOrNot" is whichList thenadd 1 to PeepCntmark cdput fld Name & "," & fld op into line x of memNamesput "Listing - " & fld "Name"add 1 to xend ifgo nextend repeatput align(memNames,"*,L","16,R") into memNamesput 1 into xgo cd "Members"if whichList is Active then put empty into whichListif memorled is "Members" thenput PeepCnt && whichList && "Scouts Listed" into cd fld ListTitleelseput PeepCnt && whichList && "Leaders Listed" into cd fld ListTitleLeaderend ifput memNames into cd fld memorledrepeat with i = 1 to the number of lines in cd fld memorledset the textstyle of line i of cd fld memorled to bold,groupend repeatput empty into opopenCardHide msgend updateListing---------------------------------------------------------on mouseEnterglobal theList,theCursget short name of targetif it is in theList thenrepeat with i = 1 to the number of items in theListif it is item i of theList thenchangeCurs item i of theCursexit repeatend ifend repeatend ifend mouseEnter---------------------------------------------------------on mouseLeavechangeCurs 128end mouseLeave---------------------------------------------------------on rankSearchput fld "Name" into namelock screengo first cd of bg "Scouts"find whole name in bg fld "Name"unlock Screen with barn door open slowlyend rankSearch---------------------------------------------------------on effect1 -- use to change backgroundsplay "PaperTurn"visual effect shrink to bottomend effect1---------------------------------------------------------on effect2 -- use to change cardsvisual dissolve to grayvisual dissolveend effect2---------------------------------------------------------on goToMapseffect1if the optionKey is down thengo to second cd of bg "Maps"elsego to first cd of bg "Maps"end ifend goToMaps---------------------------------------------------------on updateRankpush this cdif target is not empty thenput bg field "Name" into nameput target into rankDateput bg field "Rank" into ranklock screenset lockMessages to truesend mouseUp to bg btn aboutput rankdate into bg field "RankDate"put rank into bg field "Rank"put rank into bg field "Scout Rank"elseexit updateRankend ifpop cardend updateRank---------------------------------------------------------on newUpdatesput bg field "Name" into nameput the short date into rankDateput bg field "Rank" into ranklock screenset lockMessages to truesend mouseUp to bg btn aboutput rankdate into bg field "RankDate"put rank into bg field "Rank"put rank into bg field "Scout Rank"go bg "Scouts"find whole name in fld "Name"end newUpdates---------------------------------------------------------on findEm whichput fld "scout rank" into rankput fld "Plan" into planlock screenput fld "name" into namego to bg whichfind whole nameunlock Screen with barn door open slowlyif fld "Scout Rank" ≠ Rank thenput rank into fld "scout rank"end ifif fld "Plan" ≠ plan thenput plan into fld "Plan"end ifend findEm---------------------------------------------------------on findWhoglobal MarkedListget short name of bgput it into bgNameput "These are the" && the number of marked cds && ¬"members," & return & "Please make a selection:" into prompt -- ∆if MarkedList is empty thenmarkCdsend iflock screengo first cd of bg Scoutsend mouseUp to bg btn Aboutput bg fld "Scout Rank" into hisRankget showList(MarkedList,comma,prompt,false,"Find,Cancel^") -- ∆if line 1 of it is "Cancel" then exit findWhoif line 1 of it is "Find" thenput item 1 of line 2 of it into findStringlock screengo first cd of bg bgNamefind whole findString in bg fld "name"if the result is not empty thenanswer "Sorry no one with that name here!"end ifput hisRank into bg fld "Scout Rank"unlock Screen with shrink to bottomend ifend findWho---------------------------------------------------------on LockTextset the name of the target to "Unlock Text"repeat with i = 1 to the number of fldsset lockText of fld i to trueend repeatend LockText---------------------------------------------------------on UnlockTextset the name of the target to "Lock Text"repeat with i = 1 to the number of fldsset the lockText of fld i to falseend repeatend UnlockText---------------------------------------------------------on ListMeritBadges toWhereput 1 into xrepeat with i = 1 to the number of lines of fld "MeritBadges"if char 5 of line i of fld "MeritBadges" is not " " thenput line i of fld "MeritBadges" into line x of ¬cd fld toWhereadd 1 to xend ifend repeatend ListMeritBadges---------------------------------------------------------on MBRestoreglobal tempBadgesif tempBadges <> empty thenput tempBadges into fld meritBadgesput empty into tempBadgesend ifend MBRestore----------------------------------------------------------on MBPrintglobal tempBadgesdoMenu "Print Field..."MBRestoreend MBPrint-----------------------------------------------------------on evalitif line 1 of it is "Cancel" then exit evalitif line 1 of it is "Help" thengo cd "Help"exit evalitend ifend evalit-----------------------------------------------------------on Display fctn,promptglobal displayRtnput prompt into prompt -- ∆get showList(fctn,comma,prompt,true,"OK,Cancel,Help") -- ∆if line 1 of it is "Cancel" then exit Displayif line 1 of it is "Help" thengo cd "Help"end ifif line 1 of it is "OK" thenput item 1 of line 2 of it into displayRtnend ifend Display------------------------------------------------------------on nStuff whichBGput word 2 of clickline() into lineNumberput the number of lines of fld whichBG into lineCntif line lineNumber -1 of fld whichBG is empty and ¬character 1 of line lineNumber of fld whichBG is " " thenput "•" into character 1 of line lineNumber of fld whichBGask "Date completed: i.e." && the short date ¬with the short dateif it is empty then exit nStufflock Screenput length(it) into howManyrepeat for howMany -1delete character 2 of line lineNumber of fld whichBGend repeatput it into char 3 of line lineNumber of fld whichBGif lineNumber = lineCnt thenput it into fld Awardedsend closeField to fld Awardedend ifelselock Screenput " " into character 1 to 14 of line lineNumber of fld whichBGput Fillstr(space,14) into character 1 of line lineNumber of ¬fld whichBGif lineNumber = lineCnt thenput empty into fld Awardedend ifend ifend nStuff-----------------------------------------------------on closeCardglobal tempBadgeschangeCurs 6069push cardend closeCard------------------------------------------------------on closeStackglobal priorLevelput the freesize of this stack into theSizeif theSize > the size of this stack * .15 thendivide theSize by 1024set numberformat to "0"answer theSize & "K free in stack. Compact?" with "No" or "Yes"if it is "Yes" then doMenu "Compact Stack"end ifshow menubarset the userLevel to priorLevelend closeStack-------------------------------------------------------on dialIt whichget fld whichif it is empty thenask "Dial what number?"put it into fld whichelsedial itend ifend dialIton smartMBListglobal mbList, mbCnt, EmbCnt, nameput fld "Name" into thisNameif mbList is empty thenlistMBsForHimexit smartMBListend ifif name = fld "Name" thenput "Merit Badge list for" && Name & return & ¬mbCnt && "total," && EmbCnt && "from the Eagle list." into promptget showList(mbList,comma,prompt,true,"OK,Cancel,Help^") -- ∆if line 1 of it is "Cancel" then exit smartMBListif line 1 of it is "Help" thengo cd "Help"end ifelseput empty into mbListput empty into mbCntput empty into EmbCntput empty into namelistMBsForHimend ifend smartMBList</script>
